The data used in this analysis is pulled from excel documents that are the output of a MatLab program. Data from the following excel documents are read into separate dataframes before being combined into 2 master dataframes, wt_ko_sheets and wt_ko_bwaves :
Setting path to Excel files as variables
ko_path <- "data/OP_KO_scotopic_mod1.xlsx"
ko_bwave_path <- "/Users/ryanhecht/RStudio/OP_data/data/b-trace_KO_scotopic.xlsx"
wt_path <- "data/OP_WT_scotopic_mod1.xlsx"
wt_bwave_path <- "/Users/ryanhecht/RStudio/OP_data/data/b-trace_WT_scotopic.xlsx"
mk_header utlizes xl_header1 and xl_concat to contruct a preliminary data frame by pulling header titles from two different rows within the excel file
#function for getting header information from continuous cells on the original excel spreadsheet
#from_sheet specifies which sheet to take the headers from in case there is one sheet where the header values are not representative of the rest
xl_header1 <- function(path, header_range, from_sheet) {
header_names <- read_excel(path = path, range = header_range, sheet = from_sheet)
names(header_names)
}
#function for dropping sheets from the workbook, setting range, concatenating remaining sheets into single df
xl_concat <- function(path, sheet_rm, range, col_names) {
path %>%
excel_sheets() %>%
list.remove(sheet_rm) %>%
purrr::set_names() %>%
map_df(~ read_excel(path = path, sheet = .x, range = range, col_names = col_names), .id = "sheet")
}
mk_header <- function(xl_path, mouse_range, stat_range, data_range, rm_sheets) {
#gather header names for mice and statistics
mouse_names <- xl_header1(xl_path, mouse_range, 3)
stat_names <- xl_header1(xl_path, stat_range, 3)
final_header <- append(stat_names, mouse_names)
#if last element of final header doesnt end in NA, duplicate last element
#replace any mouse names that begin with "..." with NA
final_header <- final_header %>%
str_replace("^\\.+", NA_character_)
last_element <- tail(final_header,1)
if(!is.na(last_element)){
final_header <- append(final_header,last_element)
}
else {
final_header <- final_header
}
#replace all NA values with the mouse name that preceeds it. Allows duplication for left and right eyes
final_header <- final_header %>%
tibble() %>%
mutate(zoo::na.locf0(final_header)) %>%
pull()
xl_concat(xl_path, rm_sheets, data_range, final_header)
}
#building preliminary dataframes
ko_sheets <- mk_header(ko_path,"E1:U1", "B2:D2", "B2:V1822", rm_sheets = c(1,2))
## New names:
## * `` -> ...2
## * `` -> ...4
## * `` -> ...6
## * `` -> ...8
## * `` -> ...10
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
ko_bwaves <- mk_header(ko_bwave_path,"E1:U1", "B2:D2", "B2:V1822", rm_sheets = c(1,2))
## New names:
## * `` -> ...2
## * `` -> ...4
## * `` -> ...6
## * `` -> ...8
## * `` -> ...10
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
## New names:
## * `050` -> `050...4`
## * `050` -> `050...5`
## * `056` -> `056...6`
## * `056` -> `056...7`
## * `060` -> `060...8`
## * ...
wt_sheets <- mk_header(wt_path, "E1:R1", "B2:D2", "B2:R1822", rm_sheets = c(1,2))
## New names:
## * `` -> ...2
## * `` -> ...4
## * `` -> ...6
## * `` -> ...8
## * `` -> ...10
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
wt_bwaves <- mk_header(wt_bwave_path,"E1:R1", "B2:D2", "B2:R1822", rm_sheets = c(1,2))
## New names:
## * `` -> ...2
## * `` -> ...4
## * `` -> ...6
## * `` -> ...8
## * `` -> ...10
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
## New names:
## * `051` -> `051...4`
## * `051` -> `051...5`
## * `049` -> `049...6`
## * `049` -> `049...7`
## * `061` -> `061...8`
## * ...
one_header combines the two headers of the data set into one while merging “Left” and “Right” names with the appropriate mouse
one_header <- function(df, xl_path, rm_sheets, data_range) {
#get rid of the "..." in the mouse names
final_header <- names(df) %>%
str_replace("\\..*", "")
#accounts for the addition of the "sheet" column not in the excel file
final_header <- final_header[-1]
#setting up list for the loop ahead
row1 <-as.list(df[1,])
row1 <- row1[-1]
ncols <- length(row1)
#take the "left" and "right" designations from the second row and append them to the header name in first row
for (n in 1:ncols){
if(row1[n] == "Left" | row1[n] == "Right"){
as.character(final_header, row1)
final_header[n] <- paste0(final_header[n],sep = "_", row1[n])
}
}
xl_concat(xl_path, rm_sheets, data_range, final_header)
}
#contructing final data frames (OP data and B wave traces)
ko_sheets <- one_header(ko_sheets, ko_path, c(1,2),"B2:V1822")
head(ko_sheets)
ko_bwaves <- one_header(ko_bwaves, ko_bwave_path, c(1,2),"B2:V1822")
head(ko_bwaves)
wt_sheets <- one_header(wt_sheets, wt_path, c(1,2),"B2:R1822" )
head(wt_sheets)
wt_bwaves <- one_header(wt_bwaves, wt_bwave_path, c(1,2),"B2:R1822" )
head(wt_sheets)
tidy_mouse is a tidying function that performs the following operations:
pivot_longer to gather the data and separate single headers into multiple variablestidy_mouse <- function(df) {
df <- df %>%
filter(!Time == "Time")
headers <- as.list(names(df))
ncols <- ncol(df)
start_col <- which(str_detect(headers, "_")) %>%
first()
df <- df %>%
pivot_longer(cols = start_col:ncols, names_to = c("mouse", "eye"), values_to = "response", names_sep = "_") %>%
mutate(response = as.double(response),
SEM = as.double(SEM),
Mean = as.double(Mean),
Time = as.integer(Time),
eye = as.factor(eye),
mouse = as.factor(mouse)
)
df
}
# Applying to all existing dataframes
ko_sheets <- tidy_mouse(ko_sheets)
## Note: Using an external vector in selections is ambiguous.
## ℹ Use `all_of(start_col)` instead of `start_col` to silence this message.
## ℹ See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This message is displayed once per session.
## Note: Using an external vector in selections is ambiguous.
## ℹ Use `all_of(ncols)` instead of `ncols` to silence this message.
## ℹ See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This message is displayed once per session.
ko_bwaves <- tidy_mouse(ko_bwaves)
wt_sheets <- tidy_mouse(wt_sheets)
wt_bwaves <- tidy_mouse(wt_bwaves)
Using bind_rows to preserve all columns
wt_ko_sheets <- bind_rows("ko_sheets" = ko_sheets, "wt_sheets" = wt_sheets, .id = "df_source")
wt_ko_sheets
wt_ko_bwaves <- bind_rows("ko_bwaves" = ko_bwaves, "wt_bwaves" = wt_bwaves, .id = "df_source")
wt_ko_bwaves
Employing the stat_peak function to detect local extrema. Excludes peaks and valleys that are within 10 peaks of the highest/lowest
The mouse_grapher function plots the local extrema on the OP data
span and threshold control the thresholding parameters of the extrema detectionmouse_grapher <- function(df, intensity, ms_code, time_window = 500, span = 7, threshold = 0.65, result = "both") {
#identify the source sheet
source_sheet <- NULL
if (ms_code %in% ko_sheets$mouse == TRUE) {
source_sheet <- "KO"
}
if (ms_code %in% wt_sheets$mouse){
source_sheet <- "WT"
}
#check to see if mouse has response values before plotting
mouse_response <- df %>%
filter(sheet == intensity, mouse == ms_code) %>%
select(response)
if (all(!is.na(mouse_response))) {
#plot the data and show local extrema
mouse_plot <- df %>%
filter(mouse == ms_code , sheet == intensity , Time <= time_window, !is.na(response)) %>%
ggplot(aes(x = Time, y = response)) +
geom_line(aes(color = eye), alpha = 0.7) +
suppressWarnings(stat_peaks(aes(shape = eye, color = eye),
span = span, geom = "point", ignore_threshold = threshold, na.rm = TRUE))+
suppressWarnings(stat_peaks(aes(color = eye, shape = eye),
na.rm = TRUE,
geom = "text", hjust = -0.2, vjust = 0.5,
angle = 90, check_overlap = TRUE, response.label.fmt = "i",
span = span, ignore_threshold = threshold,
alpha = 0.7))+
facet_grid(~ eye, scales = "fixed", as.table = TRUE) +
ggtitle(ms_code, subtitle = source_sheet)+
theme_bw()+
theme(plot.title = element_text(size = 15, face = "bold"),
plot.subtitle = element_text(face = "italic"))
#collect the extrema values in a table
OP_max <- layer_data(mouse_plot, i = 2L) %>%
select(x, y, shape) %>%
mutate(eye = case_when(
shape == 16 ~ "Left",
shape == 17 ~ "Right")) %>%
select(-shape) %>%
kable(
caption = paste0("Mouse:", sep = " ", ms_code, "|", sep = " ", "Intensity: ", intensity, "|", sep = " ", "Source: ", source_sheet),
align = "c") %>%
row_spec(0, bold = TRUE) %>%
kable_styling(bootstrap_options = c("striped", "condensed"),
full_width = T,
fixed_thead = T)
if(result == "plot") {
return(mouse_plot)
}
if(result == "table"){
print(OP_max)
}
if(result == "both"){
print(mouse_plot)
OP_max
}
}
else {
print("Mouse has no recorded values")
}
}
mouse_grapher for each mouse and intensity#Real sheets
#sheets <- as.character(unique(wt_ko_sheets$sheet))
#mice <- as.character(unique(wt_ko_sheets$mouse))
#test sheets
sheets <- as.character(c(-2.12, 0.6))
mice <- as.character(c("050", "051"))
#for loop attempt
for (i in sheets) {
cat(" \n##", i, "{.tabset}", " \n")
for (j in mice) {
cat(" \n###", "**Mouse: **", j, " \n")
p1 <- mouse_grapher(wt_ko_sheets, intensity = i , ms_code = j , span = 7, threshold = 0.575, time_window = 300, result = "plot")
p2 <- mouse_grapher(wt_ko_bwaves, intensity = i, ms_code = j, result = "plot", time_window = 899)
grid.arrange(p1,p2)
cat("\n")
as.data.frame(mouse_grapher(wt_ko_sheets, intensity = i , ms_code = j , span = 7, threshold = 0.575, time_window = 300, result = "table"))
}
}
| x | y | eye |
|---|---|---|
| -4 | 1.34714 | Left |
| 1 | 2.26969 | Left |
| 7 | 2.02309 | Left |
| 12 | 1.59848 | Left |
| 18 | 2.37182 | Left |
| 24 | 1.74205 | Left |
| 29 | 2.14526 | Left |
| 35 | 2.97584 | Left |
| 46 | 8.40923 | Left |
| 57 | 19.64693 | Left |
| 67 | 28.06960 | Left |
| 76 | 28.06506 | Left |
| 89 | 15.47989 | Left |
| 101 | 9.00723 | Left |
| 112 | 1.80441 | Left |
| 117 | 4.45363 | Left |
| 130 | 1.17679 | Left |
| 135 | 3.56447 | Left |
| 140 | 2.10511 | Left |
| 146 | 1.53073 | Left |
| 151 | 2.69470 | Left |
| 157 | 2.04878 | Left |
| 162 | 1.66430 | Left |
| 168 | 2.68176 | Left |
| 174 | 1.82545 | Left |
| 179 | 2.28065 | Left |
| 184 | 1.93665 | Left |
| 191 | 1.55243 | Left |
| 196 | 1.70160 | Left |
| 201 | 2.47270 | Left |
| 206 | 1.75111 | Left |
| 212 | 1.89931 | Left |
| 218 | 2.11885 | Left |
| 224 | 1.84508 | Left |
| 229 | 1.76899 | Left |
| 235 | 1.66631 | Left |
| 241 | 1.76647 | Left |
| 246 | 1.82414 | Left |
| 251 | 2.21602 | Left |
| 257 | 1.72201 | Left |
| 262 | 2.43845 | Left |
| 268 | 2.15013 | Left |
| 274 | 1.64157 | Left |
| 279 | 2.04111 | Left |
| 285 | 2.20730 | Left |
| 290 | 1.79194 | Left |
| 296 | 1.86262 | Left |
| 44 | 5.13743 | Right |
| 54 | 13.26365 | Right |
| 63 | 19.67042 | Right |
| 73 | 25.08919 | Right |
| 83 | 17.32882 | Right |
| 95 | 7.84280 | Right |
| x | y | eye |
|---|---|---|
| 43 | 11.41952 | Left |
| 52 | 22.44584 | Left |
| 60 | 35.74733 | Left |
| 69 | 50.62532 | Left |
| 78 | 23.82428 | Left |
| 46 | 16.70653 | Right |
| 53 | 20.20827 | Right |
| 62 | 35.78113 | Right |
| 72 | 13.12109 | Right |
| x | y | eye |
|---|---|---|
| 31 | 49.78273 | Left |
| 42 | 82.66224 | Left |
| 54 | 61.39012 | Left |
| 67 | 29.64896 | Left |
| 28 | 43.79021 | Right |
| 38 | 92.09846 | Right |
| 50 | 87.45111 | Right |
| 61 | 49.71952 | Right |
| x | y | eye |
|---|---|---|
| 28 | 92.63049 | Left |
| 38 | 188.91619 | Left |
| 48 | 122.72285 | Left |
| 58 | 52.13857 | Left |
| 27 | 80.27059 | Right |
| 36 | 208.95278 | Right |
| 45 | 175.76152 | Right |
| 55 | 90.22953 | Right |
mouse_grapher(wt_ko_sheets, intensity = -2.12 , ms_code = "075" , span = 7, threshold = 0.575, time_window = 300, result = "plot")
mouse_grapher(wt_ko_sheets, intensity = "p0.6" , ms_code = "078" , span = 7, threshold = 0.59, time_window = 300, result = "table")
## [1] "Mouse has no recorded values"
mouse_grapher(wt_ko_bwaves, intensity = -2.12, ms_code = "075", result = "plot", time_window = 899)